perm filename TMP[GEO,BGB] blob
sn#080257 filedate 1974-01-10 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00009 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE GEOMED - GEOMETRIC EDITOR - BGB - JANUARY 1973.
C00005 00003 START ADDRESS INITIALIZATION-------------------------------------
C00007 00004 ENTRY.↑: 0 SAIL TO GEM.
C00010 00005 TITLE MEM MEMORY MANAGEMENT ROUTINES.
C00013 00006 SUBR(MKCAMERA,WORLD)
C00015 00007 SUBR(MKWINDOW,CAMERA,WINDOW) MAKE AND LINK A WINDOW NODE.
C00017 00008 SUBR(MORCOR)------------------------------------------------------
C00021 00009 SUBRS MKNODE,KLNODE MAKE AND KILL NODES.
C00023 ENDMK
C⊗;
TITLE GEOMED - GEOMETRIC EDITOR - BGB - JANUARY 1973.
SUBR GEOMED ;TELETYPE COMMAND JUMP TABLE
OUTSTR[ASCIZ/GEOMED EDITOR NOT LOADED./]↔CRLF
POP0J
ENDR GEOMED;2/4/73(BGB)----------------------------------------------
;CONTROL VARIABLES.
PDL: BLOCK =500 ;GEOMED'S INTERNAL STACK.
PDLIOWD: XWD PDL-.,PDL-1
;START ADDRESS INITIALIZATION-------------------------------------
SUBR(GEONIT)
GO SA2
ENDR GEONIT
SA: JFCL↔SETOM ALONE#
SKIPE 1,OLD44↔CORE 1,↔JFCL↔SETZM OLD44 ;CORE DOWN.
SKIPA 17,PDLIOWD
SA2: SETZM ALONE
;CREATE A GEOMED UNIVERSE.
DZM UNIVERSE
DZM BLKCNT
SETZB AVAIL ;...SO THAT @AVAIL IS ZERO.
CALL(MKUNIV)
SKIPN ALONE↔POP0J
;RE-ENTRY ADDRESS INITIALIZATION----------------------------------
REE: LACI .↔DAC 124
LAC 17,PDLIOWD
OPDEF PPIOT[702B8]
OUTCHR[14]↔PGIOT 2, ;CLEAR PIECES OF GLASS
PPIOT 2,-=250↔PPIOT 3,3003
CALL(GEODPY↑)
CALL(GEOMED)
EXIT↔LIT
;2/4/73-----------------------------------------------------------
ENTRY.↑: 0 ;SAIL TO GEM.
DAC 12,SAIL12#
DAC 16,SAIL16#
DAC 17,SAIL17# ;USING SAIL'S PDL.
GO@ENTRY.
EXIT.↑: 0 ;GEM TO SAIL.
LAC 12,SAIL12
LAC 16,SAIL16
LAC 17,SAIL17
GO@EXIT.
ENTERS↑: -1
LIT
;TITLE MEM ;MEMORY MANAGEMENT ROUTINES.
OLD44: 0 ;ORIGINAL JOBREL 44 CONTENTS.
UNIVER↑: 0 ;POINTER TO UNIVERSE NODE.
BLKCNT: 0 ;NUMBER OF NON EMPTY NODES.
AVAIL: 0 ;POINTER TO FIRST EMPTY NODE.
REMAINDER:0 ;NUMBER OF UNUSED WORDS BETWEEN
; THE TOP OF NODE SPACE AND THE TOP OF CORE.
INVALID:0 ;SET DURING SHRINK
NODSIZ←←=12 ;NUMBER OF WORDS PER NODE.
MINLINK←←-3 ;LOWEST NUMBERED LINK
TYPMASK←←17 ;MASK TO EXTRACT TYPE INFORMATION
SUBR(MKUNIV) ;MAKE UNIVERSE.
COMMENT ⊗------------------------------------------------------------
⊗
SETQ(WORLD,{MKWORLD}) ;MAKE A WORLD FOR THIS UNIVERSE.
SETQ(CAMERA,{MKCAMERA,WORLD}) ;MAKE A CAMERA FOR THIS WORLD.
SETQ(SUN,{MKCAMERA,[0]}) ;MAKE A SUN (LIKE A CAMERA).
LACI $SUN↔DAP(1) ;MARK THE NODE AS SUN TYPE.
FRAME 2,1↔LAC[100.0]↔DAC ZWC(1) ;PLACE SUN A HUNDRED FEET UP.
LAC 2,WORLD↔ALT. 1,2 ;PLACE THE SUN IN THE WORLD.
CALL(MKWINDOW,CAMERA,[0]) ;MAKE A WINDOW FOR THIS CAMERA.
POP0J
DECLARE{WORLD,CAMERA,SUN}
ENDR MKUNIV;7/12/73(BGB)---------------------------------------------
SUBR(MKWORLD) ;MAKE A WORLD NODE.
COMMENT ⊗------------------------------------------------------------
⊗
SETQ(WORLD#,{MKNODE,[PBIT+$WORLD]})
CW. 1,1↔CCW. 1,1 ;EMPTY BODY RING.
BRO. 1,1↔SIS. 1,1 ;WORLD RING.
CALL(MKFRAME↑) ;WORLD FRAME OF REFERENCE.
LAC 2,WORLD
FRAME. 1,2
;PLACE NEW WORLD AT THE END OF THE WORLD RING.
LAC 1,WORLD
LAC 4,UNIVERSE↔PWRLD 2,4 ;GET FIRST WORLD OF THIS UNIVERSE.
JUMPN 2,.+4
NWRLD. 1,4↔PWRLD. 1,4 ;INIT THE UNIVERSE'S WORLD RING.
POP0J
BRO 3,2
BRO. 1,2↔SIS. 2,1 ;RING-IN THE NEW WORLD.
SIS. 1,3↔BRO. 3,1
POP0J
ENDR MKWORLD;3/12/73(BGB)--------------------------------------------
SUBR(MKCAMERA,WORLD)
COMMENT ⊗------------------------------------------------------------
If WORLD argument is not zero then place camera in world's camera ring.
⊗
SETQ(CAMERA#,{MKNODE,[PBIT+$CAMERA]})
BRO. 1,1↔SIS. 1,1 ;CAMERA RING.
SKIPE 2,WORLD↔PWRLD. 2,1 ;CAMERA POINTS AT ITS WORLD.
;DEFAULT PHYSICAL RASTER SIZE.
DEFINE MM{3.280833E-3}
DEFINE MICRON{3.280833E-6}
LAC[38.78]↔FMPR[MICRON]↔DAC 1(1) ;PDX.
LAC[40.00]↔FMPR[MICRON]↔DAC 2(1) ;PDY.
LAC[12.50]↔FMPR[MM]↔ DAC 3(1) ;FOCAL
LACN 3(1)↔FDVR 1(1)↔DAC -3(1) ;SCALEX ← -FOCAL/PDX
LACN 3(1)↔FDVR 2(1)↔DAC -2(1) ;SCALEY ← -FOCAL/PDY
LACN 3(1)↔FDVR 2(1)↔DAC -1(1) ;SCALEZ ← -FOCAL/PDZ
;CAMERA LOCUS AND ORIENTATION.
CALL(MKFRAME↑)
LAC[16.0]↔DAC ZWC(1) ;16 FEET ABOVE XY PLANE.
LAC 2,CAMERA↔FRAME. 1,2
;PLACE NEW CAMERA AT THE END OF THE WORLD'S CAMERA RING.
LAC 1,CAMERA
LAC 4,WORLD↔PCAMR 2,4 ;GET FIRST CAMERA OF THIS WORLD.
JUMPN 2,.+4
NCAMR. 1,4↔PCAMR. 1,4 ;INIT THE WORLD'S CAMERA RING.
POP1J
BRO 3,2
BRO. 1,2↔SIS. 2,1 ;RING-IN THE NEW CAMERA.
SIS. 1,3↔BRO. 3,1↔POP1J
ENDR MKCAMERA;3/12/73(BGB)-------------------------------------------
SUBR(MKWINDOW,CAMERA,WINDOW) ;MAKE AND LINK A WINDOW NODE.
COMMENT ⊗------------------------------------------------------------
CAMERA argument may be zero.
Zero WINDOW argument will cause a new Display ring;
Otherwise new window placed into the display ring of the given window.
⊗
CALL(MKNODE,[PBIT+$WINDOW])
LAC[3.5]↔DAC -1(1) ;MAG
LAC[XWD -=511,=511]↔DAC 1(1) ;XWD XL,,XH
LAC[XWD -=384,=384]↔DAC 2(1) ;XWD YL,,YH
LAC CAMERA↔NCAMR. 0,1 ;POINTER TO CAMERA.
BRO. 1,1↔SIS. 1,1 ;WINDOW RING.
CW. 1,1↔CCW. 1,1 ;DISPLAY RING.
;PLACE NEW WINDOW IN DISPLAY RING NEXT TO GIVEN WINDOW.
SKIPN 2,WINDOW↔GO L1
SIS 3,2
SIS. 1,2↔BRO. 2,1
BRO. 1,3↔SIS. 3,1↔POP2J
;PLACE NEW WINDOW IN BRAND NEW DISPLAY RING, ALL BY ITSELF.
L1:
LAC 4,UNIVERSE↔CCW 2,4 ;GET FIRST DISPLAY RING.
CW. 1,4↔CCW. 1,4 ;UPDATE UNIVERSE NODE.
JUMPE 2,POP2J. ;EXIT WHEN FIRST DISPLAY RING.
CCW 3,2
CCW. 1,2↔CW. 2,1 ;RING-IN A NEW DISPLAY RING.
CW. 1,3↔CCW. 3,1
POP2J
ENDR MKWINDOW;3/12/73(BGB)-------------------------------------------
SUBR(MORCOR)------------------------------------------------------
ACCUMULATORS{PTR,SIZ}
; - GET MORE CORE FROM SAIL - BGB - 8 MARCH 1972.
PUSH P,PTR↔PUSH P,SIZ
SETZ PTR,
L1: LACI SIZ,NODSIZ*=400+1 ;AC3 SIZE OF SPACE.
CALL(CORGET↑) ;AC2 ADDRESS OF SPACE.
GO[FATAL(NO MORE CORE.)]↔SOS SIZ
SLACI(PTR)↔LAPI 1(PTR)↔DZM(PTR) ;CLEAR 4K BLOCK OF MEMORY.
BLT NODSIZ*=400-1(PTR) ;CLEAR 4K BLOCK OF MEMORY.
LAC 1,PTR ;-3 WORD OF FIRST NODE.
;INITIALIZE THE UNIVERSE WHEN NECESSARY.
SKIPE UNIVER↔GO L3
ADDI 1,1↔DAC 1,AVAIL ;POINTER TO AVAIL LIST.
ADDI 1,1↔DAC 1,BLKCNT ;POINTER TO NODE COUNT.
ADDI 1,1↔DAC 1,UNIVERSE ;POINTER TO UNIVERSE NODE.
LACI 2↔DAP@UNIVERSE ;UNIVERSE NODE IS TYPE #2.
;MAKE AVAIL LIST.
L3: DIP 1,1↔ADD 1,[XWD NODSIZ,0] ;XWD NEXT,,THIS
SKIPN@BLKCNT↔GO[
ADD 1,[XWD NODSIZ,NODSIZ] ;STEP OVER UNIVERSE.
AOS@BLKCNT↔SUBI SIZ,NODSIZ↔GO .+1]
SUBI SIZ,NODSIZ
DAPZ 1,@AVAIL
;PLACE EACH NEW EMPTY BLOCK ON THE AVAIL LIST.
L2: HLRZM 1,(1)↔AOS 3(1) ;EMPTY LIST POINTER & TYPE #1.
ADD 1,[XWD NODSIZ,NODSIZ]
SUBI SIZ,NODSIZ
JUMPG SIZ,L2↔AOS 3(1)
LAC 1,@AVAIL
POP P,3↔POP P,2↔POP0J
ENDR MORCOR;------------------------------------------------------
;SUBRS MKNODE,KLNODE ;MAKE AND KILL NODES.
;--------------------------------------------------------------------
SUBR(MKNODE,NODTYP) ;ALLOCATE A BLOCK OF NODSIZ WORDS.
SKIPN 1,@AVAIL↔CALL(MORCOR) ;GET AN EMPTY NODE.
CDR(1)↔DAP @AVAIL
DZM(1)↔AOS @BLKCNT↔ADDI 1,3
LAC NODTYP↔DAC(1) ;PLACE NODE TYPE INTO NODE.
POP1J
ENDR MKNODE;12/4/72(BGB)---------------------------------------------
SUBR(KLNODE,NODE) ;RELEASE BLOCK OF NODSIZ WORDS.
LAC 1,NODE↔LAC (1)
CAIN 0,1↔GO[FATAL(KILLING EMPTY NODE.)]
SOS @BLKCNT
LIPI -3(1)↔LAPI -2(1) ;CLEAR NODE.
SETZM -3(1)↔BLT 8(1)
AOS(1) ;MARK NODE TYPE EMPTY-1.
SUBI 1,3↔LAC@AVAIL ;CONS NODE TO AVAIL LIST.
DAPZ(1)↔DAPZ 1,@AVAIL
POP1J
ENDR KLNODE;12/4/72(BGB)---------------------------------------------
END
GEOMED.FAI - EOF.